home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Games / PC-SIG World of Games (CDRM1080710) (1993).iso / 1523 / OTH.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  55KB  |  1,591 lines
  1. program othello;
  2. {The following program incorporates data structures and game
  3.  strategies to produce a computerized version of othello (reversi) for
  4.  educational and entertainment purposes.  This program was
  5.  originally written on turbo pascal 4.0 but is fully compatable
  6.  with 5.0 and all IBM PC compatable computers.
  7.  
  8.  Editing Programmer : Erich J Spengler.
  9.  
  10.  Programmers : Andy Collinson,
  11.                Mark Bensley, Brett Bensley
  12.                Karla Richter, Erich Spengler.
  13.  
  14.  Procedure Programmers :
  15.  
  16.  1) Erich J Spengler : cursor, set_window, print_menu, print_board_frame,
  17.                        count, finalcount, print_board, init_game,
  18.                        reverse_board, findmoves, value_print, locate_square,
  19.                        getcoord, ((((chk_A_add, recommend, lookahead----
  20.                        replaced by Karla's lookahead)))), first_move,
  21.                        second_move_1, second_move_2, deter_winner,
  22.                        check_game_done, pick_option, execute_first_move,
  23.                        execute_second_move, terminate_game, Main-Routine.
  24.                        (many of the above came from reference material)
  25.  
  26.  2) Andy Collinson  : initweigharray, findbestmove.
  27.  
  28.  3) Mark Bensley    : makemoves, getcoord.
  29.  
  30.  4) Brett Bensley   : unmove, title_and_instructions, getcoord.
  31.  
  32.  4) Karla Richter   : LookAhead( Can be beaten in 8 moves every time???? ).
  33.  
  34. Cooperation Time    : Andy  - 4.0 Hours.
  35. (Time spent with      Mark  - 4.0 Hours.
  36.  Editor)              Brett  - 4.0 Hours.
  37.                       Karla - 1.0 Hours.
  38. }
  39.  
  40. uses
  41.    crt,       { standard i/o }
  42.    dos;       { for register manipulation }
  43.  
  44. type
  45.    string2        = string[2];            {string type of length 2}
  46.    makmovetype    = record                {record type containing..}
  47.                        imm,               {..a single move}
  48.                        jmm  : shortint;
  49.                     end;
  50.    squaretype     = record                {record type containing..}
  51.                        data : shortint;   {..data in each board square}
  52.                     end;
  53.    possmvsrectype = record                {record type containing..}
  54.                       row,                {..possible moves and..}
  55.                       col,                {..corresponding flips}
  56.                       nflps : shortint;
  57.                     end;
  58.    bestmvetype    = record                {record type containing..}
  59.                        xcoord,            {..best move and board value}
  60.                        ycoord,
  61.                        val  : longint;
  62.                     end;
  63.    on_off_type    = (on,off);             {on,off switch type}
  64.    movetype       = (good,bad);           {good or bad move type}
  65.    playtype       = (first,second);       {which player is moving}
  66.    coordstatustype= (ok,non_avail);       {status for empty board square}
  67.    actiontype     = (save,return);        {choice for saving a board}
  68.    gamestatus     = (first_win,second_win,tie,continue); {type for who wins}
  69.    a1type         = array[1..8] of shortint;
  70.    a2type         = array[1..10,1..10] of shortint;
  71.    a3type         = array[1..10,1..10] of squaretype;
  72.    a4type         = array[1..30] of possmvsrectype;
  73.    a5type         = array[2..9,2..9] of shortint;
  74.    xorbtype       = a1type;               {type for x board orbiting}
  75.    yorbtype       = a1type;               {type for y board orbiting}
  76.    flparrytype    = a2type;               {array for temp storage of flips}
  77.    boardarrytype  = a3type;               {board storage array}
  78.    posmvarrytype  = a4type;               {possible move storage}
  79.    weigharraytype = a5type;               {weight of possible moves storage}
  80.  
  81. const
  82.    empty = '  ';                          {empty color}
  83.    firstchr = '░░';                       {first piece color}
  84.    secondchr = '██';                      {second piece color}
  85.    firstnum = 1;                          {first number}
  86.    secondnum = -1;                        {second number}
  87.  
  88. var
  89.    ch          : char;                    {keyboard character}
  90.    xorb        : a1type;                  {x orbiting array}
  91.    yorb        : a1type;                  {y orbiting array}
  92.    play_1,                                {boolean for one or two players}
  93.    quit,                                  {for quitting game}
  94.    pass,                                  {for passing turn}
  95.    done        : boolean;                 {when game is done}
  96.    level       : integer;                 {level of computer tree search}
  97.    play        : playtype;                {which player is playing}
  98.    game        : gamestatus;              {what status game is in}
  99.    board,                                 {playing board}
  100.    board2,                                {tree searching board}
  101.    tempboard,                             {tempoary boards 1-3}
  102.    tempboard2,
  103.    tempboard3  : boardarrytype;
  104.    weigharr    : weigharraytype;          {weight array for move value}
  105.  
  106. {************************ PASCAL CODE FOR OTHELLO ***************************}
  107.  
  108. procedure cursor(stype:char;switch:on_off_type);
  109. {shuts off or on cursor using interrupt and register change}
  110. var
  111.    regs : registers;
  112. begin
  113.    with regs do
  114.       begin
  115.          ah := $01;
  116.          if switch = on then                {turn on}
  117.             begin
  118.                case stype of
  119.                'M' : begin                  {for mono board}
  120.                         ch := 12;
  121.                         cl := 13;
  122.                      end;                   {for color board}
  123.                'C' : begin
  124.                         ch := 6;
  125.                         cl := 7;
  126.                      end;
  127.                else ;
  128.             end;
  129.          end
  130.       else
  131.          begin
  132.             case stype of                   {turn off}
  133.             'M' : begin                     {for mono board}
  134.                      ch := 14;
  135.                      cl := 14;
  136.                   end;
  137.             'C' : begin                     {for color board}
  138.                      ch := 8;
  139.                      cl := 8;
  140.                   end;
  141.             else ;
  142.          end;
  143.       end;
  144.    end;
  145.    intr($10,regs);                          {call interrupt}
  146. end;
  147.  
  148. procedure title_and_instructions;
  149. {print title page and game instructions}
  150. var
  151.    inccount    : 2..24;
  152.    key         : string;
  153. begin
  154.    clrscr;
  155.    write('╔══════════════════════════════════════════════════════════════════════════════╗');
  156.    for inccount := 2 to 23 do
  157.    write('║                                                                              ║');
  158.    write('╚══════════════════════════════════════════════════════════════════════════════╝');
  159.    gotoxy(34,2);
  160.    write('   ║╩╩╩║       ');
  161.    gotoxy(34,3);
  162.    write('╔══╩╗ ╔╩╦═╗    ');
  163.    gotoxy(34,4);
  164.    write('║  ═╣ ║ ║ ║    ');
  165.    gotoxy(34,5);
  166.    write('║  ═╣ ║ ╨ ║    ');
  167.    gotoxy(34,6);
  168.    write('╚═══╩═╩═══╝');
  169.    highvideo;
  170.    gotoxy(19,8);
  171.    write('█████ █████ █  █ █████ █     █     █████  (R)');
  172.    gotoxy(19,9);
  173.    write('█▒▒▒█▒ ▒█▒▒▒█▒ █▒█▒▒▒▒▒█▒    █▒    █▒▒▒█▒');
  174.    gotoxy(19,10);
  175.    write('█▒  █▒  █▒  ████▒████  █▒    █▒    █▒  █▒');
  176.    gotoxy(19,11);
  177.    write('█▒  █▒  █▒  █▒▒█▒█▒▒▒▒ █▒    █▒    █▒  █▒');
  178.    gotoxy(19,12);
  179.    write('█████▒  █▒  █▒ █▒█████ █████ █████ █████▒');
  180.    gotoxy(19,13);
  181.    write(' ▒▒▒▒▒   ▒   ▒  ▒ ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒▒');
  182.    gotoxy(15,15);
  183.    lowvideo;
  184.    write('Produced by students of MAT 4870 "Data Structures"');
  185.    gotoxy(18,16);
  186.    write('Eastern Illinois University, Charleston, IL');
  187.    gotoxy(31,17);
  188.    write('Fall Semester 1988');
  189.    gotoxy(14,20);
  190.    write('(R) Registered Trademark of Gabriel Industries, Inc.');
  191.    gotoxy(22,22);
  192.    write('(C) Game Copyright MCMLXXVII Gabriel');
  193.    gotoxy(26,24);
  194.    highvideo;
  195.    textattr := textattr+128;
  196.    write(' Press any key to continue. ');
  197.    normvideo;
  198.    gotoxy(19,12);
  199.    repeat until keypressed;
  200.    key := readkey;
  201.    clrscr;
  202.    writeln('Rules :');
  203.    writeln;
  204.    writeln('1. Black moves first.');
  205.    writeln;
  206.    writeln('2. A move consists of "outflanking" (border a row of your opponent',chr(39),'s disc(s)');
  207.    writeln('   with your discs) your opponent',chr(39),'s disc(s) to flip the outflanked disc(s) to');
  208.    writeln('   your color.');
  209.    writeln;
  210.    writeln('3. If a player cannot outflank and flip at least one opponent',chr(39),'s disc, the');
  211.    writeln('   turn is forfeited and the opponent moves again.');
  212.    writeln;
  213.    writeln('4. A disc may outflank any number of discs in one or more rows.');
  214.    writeln;
  215.    writeln('5. A disc may outflank in any direction: horizontal, vertical, diagonal.');
  216.    writeln;
  217.    writeln('6. A disc may outflank in any number of directions at the same time.');
  218.    writeln;
  219.    writeln('7. A disc may only be outflanked as a direct result of a move and must fall');
  220.    writeln('   in the direct line of the disc placed down.');
  221.    writeln;
  222.    writeln('8. The game is over when either no more moves can be made by either player,');
  223.    writeln('   or you quit the game.');
  224.    writeln;
  225.    writeln('9. The player with the most discs of his or her color wins.');
  226.    gotoxy(26,1);
  227.    highvideo;
  228.    textattr := textattr+128;
  229.    write(' Press any key to continue. ');
  230.    normvideo;
  231.    repeat until keypressed;
  232.    key := readkey;
  233.    lowvideo;
  234.    clrscr;
  235. end;
  236.  
  237. procedure set_window(x1,y1,x2,y2:shortint);
  238. {draw a two bar frame window around given coordinates}
  239. const
  240.    ulc = #201;          {upper left corner}
  241.    hb  = #205;          {horiz bar}
  242.    urc = #187;          {upper right corner}
  243.    vb  = #186;          {vert bar}
  244.    llc = #200;          {lower left corner}
  245.    lrc = #188;          {lower right corner}
  246. var
  247.    i : shortint;        {loop variable}
  248. begin
  249.    gotoxy(x1+1,y1);
  250.    write(ulc);
  251.    for i := x1+1 to x2-2 do            {draw top}
  252.       write(hb);
  253.    write(urc);
  254.    for i := y1+1 to y2-3 do
  255.       begin
  256.          gotoxy(x1+1,i);write(vb);     {draw vert sides}
  257.          gotoxy(x2,i);write(vb);
  258.       end;
  259.    gotoxy(x1+1,y2-2);
  260.    write(llc);
  261.    for i := x1+1 to x2-2 do            {draw bottom}
  262.       write(hb);
  263.    write(lrc);
  264. end;
  265.  
  266. procedure print_menu;
  267. {draw menu to choose in-play game options}
  268. begin
  269.    set_window(3,2,37,7);
  270.    gotoxy(4,6);
  271.    write('          Message Block           ');
  272.    gotoxy(4,8);
  273.    write('< Move Selector Using Arrow Keys. >');
  274.    gotoxy(4,9);
  275.    write('< Choose Option Before Moving. >');
  276.    gotoxy(6,11);
  277.    write('Game Options');
  278.    gotoxy(11,12);
  279.    write('During Play :');
  280.    gotoxy(8,14);
  281.    write('(Q)uit   : End Game.');             {quit}
  282.    gotoxy(8,16);
  283.    write('(P)ass   : Pass Turn.');            {pass}
  284.    gotoxy(8,18);
  285.    write('(U)ndo   : Undo Last Move.');       {undo move}
  286.    gotoxy(8,20);
  287.    write('(S)witch : Change Players.');       {reverse board}
  288.    gotoxy(8,22);
  289.    write('(H)int   : Hint From Computer.');   {give player hint}
  290. end;
  291.  
  292. procedure print_board_frame;
  293. {print playing board on the screen - this is only done once}
  294. var
  295.    x, y : shortint;
  296. begin
  297.    print_menu;
  298.    set_window(1,1,80,25);              {draw screen frame}
  299.    gotoxy(49,3);
  300.    write(firstchr,'  ','Player #1 Score : ');
  301.    gotoxy(49,5);
  302.    write(secondchr,'  ','Player #2 Score : ');
  303.    x := 40;
  304.    y := 7;
  305.    gotoxy(x,y);
  306.    write('╔════╤════╤════╤════╤════╤════╤════╤════╣');
  307.    gotoxy(x,y+1);
  308.    write('║    │    │    │    │    │    │    │    ║');
  309.    gotoxy(x,y+2);
  310.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  311.    gotoxy(x,y+3);
  312.    write('║    │    │    │    │    │    │    │    ║');
  313.    gotoxy(x,y+4);
  314.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  315.    gotoxy(x,y+5);
  316.    write('║    │    │    │    │    │    │    │    ║');
  317.    gotoxy(x,y+6);
  318.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  319.    gotoxy(x,y+7);
  320.    write('║    │    │    │    │    │    │    │    ║');
  321.    gotoxy(x,y+8);
  322.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  323.    gotoxy(x,y+9);
  324.    write('║    │    │    │    │    │    │    │    ║');
  325.    gotoxy(x,y+10);
  326.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  327.    gotoxy(x,y+11);
  328.    write('║    │    │    │    │    │    │    │    ║');
  329.    gotoxy(x,y+12);
  330.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  331.    gotoxy(x,y+13);
  332.    write('║    │    │    │    │    │    │    │    ║');
  333.    gotoxy(x,y+14);
  334.    write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
  335.    gotoxy(x,y+15);
  336.    write('║    │    │    │    │    │    │    │    ║');
  337.    gotoxy(x,y+16);
  338.    write('╩════╧════╧════╧════╧════╧════╧════╧════╝');
  339. end;
  340.  
  341. procedure unmove(var board,tempboard:boardarrytype;action:actiontype);
  342. {save or return a board into or from another board}
  343. var
  344.    x,y : shortint;
  345. begin
  346.    if action = save then
  347.       begin
  348.          for x := 1 to 10 do
  349.             for y := 1 to 10 do
  350.                tempboard[x,y].data := board[x,y].data;
  351.       end
  352.    else
  353.       begin
  354.          for x := 1 to 10 do
  355.             for y := 1 to 10 do
  356.                board[x,y].data := tempboard[x,y].data;
  357.       end;
  358. end;
  359.  
  360. procedure count(board:boardarrytype;var game:gamestatus);
  361. {count pieces of each player and set game to whos winning}
  362. var
  363.    i, j,                   {loop variables}
  364.    ply_pieces,             {first players pieces}
  365.    cmp_pieces : shortint;  {second players pieces}
  366. begin
  367.    ply_pieces := 0;
  368.    cmp_pieces := 0;
  369.    for i := 2 to 9 do
  370.       for j := 2 to 9 do
  371.          with board[i,j] do
  372.          begin
  373.             if data = 1 then
  374.                inc(ply_pieces)
  375.             else if data = -1 then
  376.                inc(cmp_pieces);
  377.          end;
  378.    if ply_pieces + cmp_pieces = 64 then      {check total pieces}
  379.       if ply_pieces > cmp_pieces then        {compare....}
  380.          game := first_win
  381.       else if ply_pieces < cmp_pieces then
  382.          game := second_win
  383.       else if ply_pieces=cmp_pieces then
  384.          game := tie;
  385.    if ply_pieces + cmp_pieces <> 64 then
  386.       if (ply_pieces=0)  then
  387.          game := second_win
  388.       else if (cmp_pieces=0) then
  389.          game := first_win
  390.       else
  391.          game := continue;
  392. end;
  393.  
  394. procedure finalcount(board:boardarrytype;
  395.                      var ply_pieces,cmp_pieces:shortint);
  396. {count each number of players in a given board}
  397. var
  398.    i,j : shortint; {loop variables}
  399. begin
  400.    ply_pieces := 0;
  401.    cmp_pieces := 0;
  402.    for i := 2 to 9 do                        {loop until board counted}
  403.       for j := 2 to 9 do
  404.          with board[i,j] do
  405.             begin
  406.                if data = 1 then
  407.                   inc(ply_pieces)
  408.                else if data = -1 then
  409.                   inc(cmp_pieces);
  410.             end;
  411. end;
  412.  
  413. procedure print_board(board:boardarrytype;var game:gamestatus);
  414. {print board and current scores for each player}
  415. var
  416.    i, j,
  417.    x, y,
  418.    plyscr, cmpscr : shortint;   {board values and loop variables}
  419.    chstr          : string2;
  420. begin
  421.    x := 42;
  422.    y := 8;
  423.    plyscr := 0;
  424.    cmpscr := 0;
  425.    for i := 2 to 9 do
  426.       begin
  427.          for j := 2 to 9 do
  428.             begin
  429.                with board[i,j] do
  430.                   begin
  431.                      if data =  0 then
  432.                         chstr := empty
  433.                      else if data = -1 then
  434.                         begin
  435.                            chstr := secondchr;
  436.                            inc(cmpscr);
  437.                         end
  438.                      else if data =  1 then
  439.                         begin
  440.                            chstr := firstchr;
  441.                            inc(plyscr);
  442.                         end;
  443.                      gotoxy(x,y);
  444.                      write(chstr);
  445.                      x := x + 5;
  446.                   end;
  447.             end;
  448.          x := 42;
  449.          y := y+2;
  450.       end;
  451.    gotoxy(70,3);           {write scores}
  452.    write(plyscr:2);
  453.    gotoxy(70,5);
  454.    write(cmpscr:2);
  455. end;
  456.  
  457. procedure initweigharray(var weigharr:weigharraytype);
  458. {initialize weight array for board values during computer play}
  459. {each square is given a special strategy weight}
  460. begin
  461.    weigharr[2,2] := 26 ;weigharr[2,3] := 1  ;weigharr[2,4] := 17;
  462.    weigharr[2,5] := 15 ;weigharr[2,6] := 15 ;weigharr[2,7] := 17;
  463.    weigharr[2,8] := 1  ;weigharr[2,9] := 26 ;weigharr[3,2] := 1;
  464.    weigharr[3,3] := 1  ;weigharr[3,4] := 5  ;weigharr[3,5] := 6;
  465.    weigharr[3,6] := 6  ;weigharr[3,7] := 5  ;weigharr[3,8] := 1;
  466.    weigharr[3,9] := 1  ;weigharr[4,2] := 17 ;weigharr[4,3] := 5;
  467.    weigharr[4,4] := 8  ;weigharr[4,5] := 9  ;weigharr[4,6] := 9;
  468.    weigharr[4,7] := 8  ;weigharr[4,8] := 5  ;weigharr[4,9] := 17;
  469.    weigharr[5,2] := 15 ;weigharr[5,3] := 6  ;weigharr[5,4] := 9;
  470.    weigharr[5,7] := 9  ;weigharr[5,8] := 6  ;weigharr[5,9] := 15;
  471.    weigharr[6,2] := 15 ;weigharr[6,3] := 6  ;weigharr[6,4] := 9;
  472.    weigharr[6,7] := 9  ;weigharr[6,8] := 6  ;weigharr[6,9] := 15;
  473.    weigharr[7,2] := 17 ;weigharr[7,3] := 5  ;weigharr[7,4] := 8;
  474.    weigharr[7,5] := 9  ;weigharr[7,6] := 9  ;weigharr[7,7] := 8;
  475.    weigharr[7,8] := 5  ;weigharr[7,9] := 17 ;weigharr[8,2] := 1;
  476.    weigharr[8,3] := 1  ;weigharr[8,4] := 5  ;weigharr[8,5] := 6;
  477.    weigharr[8,6] := 6  ;weigharr[8,7] := 5  ;weigharr[8,8] := 1;
  478.    weigharr[8,9] := 1  ;weigharr[9,2] := 26 ;weigharr[9,3] := 1;
  479.    weigharr[9,4] := 17 ;weigharr[9,5] := 15 ;weigharr[9,6] := 15;
  480.    weigharr[9,7] := 17 ;weigharr[9,8] := 1  ;weigharr[9,9] := 26;
  481. end;
  482.  
  483. procedure init_game(var board:boardarrytype);
  484. {initialize game and all necessary variables}
  485. var
  486.    e        : integer;       {error code for val call}
  487.    i, j,                     {loop variables}
  488.    plyscr,                   {players score}
  489.    num_play,                 {number of players}
  490.    cmpscr   : shortint;      {second players score}
  491. begin
  492.    clrscr;                   {clear screen}
  493.    randomize;                {have extra ramdom numbers if needed}
  494.    quit:=false;              {set quit to false}
  495.    pass:=false;              {set pass to false}
  496.    done := false;            {set done to no}
  497.    game := continue;         {let game continue}
  498.    cursor('M',off);          {shut off cursor}
  499.    cursor('M',off);          {just making sure}
  500.    title_and_instructions;   {print title page and instructions}
  501.    initweigharray(weigharr); {initialize weight array}
  502.                              {initialize orbit arrays}
  503.    xorb[1] := -1;xorb[2] := -1;xorb[3] := 0;xorb[4]  := 1;
  504.    yorb[1] := 0;yorb[2]  := 1;yorb[3]  := 1;yorb[4]  := 1;
  505.    xorb[5] := 1;xorb[6]  := 1;xorb[7]  := 0;xorb[8]  := -1;
  506.    yorb[5] := 0;yorb[6]  := -1;yorb[7] := -1;yorb[8] := -1;
  507.    {set board pieces to blank}
  508.    for i := 1 to 10 do
  509.       begin
  510.          for j := 1 to 10 do
  511.             begin
  512.                with board[i,j] do
  513.                   begin
  514.                      data := 0;
  515.                   end;
  516.             end;
  517.       end;
  518.    plyscr := 2;                    {initialize player 1 score}
  519.    cmpscr := 2;                    {initialize player 2 score}
  520.    board[5,5].data := 1;           {first initialization}
  521.    board[6,6].data := 1;
  522.    board[5,6].data := -1;          {second initialization}
  523.    board[6,5].data := -1;
  524.    unmove(board,tempboard,save);   {set temporary boards to original}
  525.    unmove(board,tempboard2,save);
  526.    unmove(board,tempboard3,save);
  527.    for i := 1 to 10 do
  528.       begin                        {set boarder of board...}
  529.          with board[1,i] do        {...values to 2}
  530.             data := 2;
  531.          with board[10,i] do
  532.             data := 2;
  533.          with board[i,1] do
  534.             data := 2;
  535.          with board[i,10] do
  536.             data := 2;
  537.       end;
  538.    print_board_frame;              {print board frame}
  539.    print_board(board,game);        {print board}
  540.    gotoxy(6,3);
  541.    write('Enter # of Players (1,2) : ');  {ask number of players}
  542.    repeat                                 {read in # of players}
  543.       gotoxy(33,3);
  544.       write(' ');
  545.       gotoxy(33,3);
  546.       read(ch);
  547.    until ch in ['1'..'2'];
  548.    val(ch,num_play,e);                    {change character to numeric}
  549.    gotoxy(6,3);
  550.    write(' ':30);
  551.    case num_play of                       {set boolean for player #}
  552.       1 : play_1 := true;
  553.       2 : play_1 := false;
  554.    end;
  555.    if play_1 then                         {if computer plays set level}
  556.       begin
  557.          gotoxy(6,3);
  558.          write('Enter Play Level (1-4) : ');
  559.          repeat
  560.             gotoxy(31,3);                 {read in player level}
  561.             write(' ');
  562.             gotoxy(31,3);
  563.             read(ch);
  564.          until ch in ['1'..'4'];
  565.          val(ch,level,e);                 {change char to numeric}
  566.          gotoxy(6,3);
  567.          write(' ':30);
  568.          case level of                    {set level of tree search}
  569.             1 : level := 0; {*****no pruning procedure,...}
  570.             2 : level := 1; {...therefore a search greater than 3...}
  571.             3 : level := 2; {...takes an extremely long time...}
  572.             4 : level := 3; {...but lookahead does not work...}
  573.          end                {...correctly at search level 3********}
  574.       end
  575.    else                              {should never leave un set variables}
  576.       level:=1;                      {else set level to 1}
  577. end;
  578.  
  579. procedure reverse_board(var board:boardarrytype);
  580. {procedure will reverse a given board}
  581. var
  582.    i, j  : shortint;
  583.    value : shortint;
  584. begin
  585.    for i := 2 to 9 do                    {loop through board}
  586.       begin
  587.          for j := 2 to 9 do
  588.             begin
  589.                with board[i,j] do
  590.                   begin
  591.                      if data=-1 then
  592.                         value := 1        {switch numbers of board}
  593.                      else if data=1 then
  594.                         value := -1
  595.                      else
  596.                         value := 0;
  597.                      data  :=  value;
  598.                   end;
  599.             end;
  600.       end;
  601.    print_board(board,game);   {print reversed board}
  602.    gotoxy(6,4);               {goto message block for message set up}
  603. end;
  604.  
  605. procedure findmoves(board:boardarrytype;player:shortint;
  606.                     var possmvs : posmvarrytype);
  607. {find all possible moves for a given player and then load an array
  608.  with those moves and corresponding possible flips}
  609. {this will be done by using the orbit arrays to circle around and
  610.  search all possible directions until a move is found to be good or bad}
  611. var
  612.    i, j, k,                    {loop variables}
  613.    x, y, z,                    {more loop variables}
  614.    nflips,                     {flips possible for each move}
  615.    mvi, mvj,                   {move values for directional search}
  616.    imov, jmov,                 {temp values for mvi and mvj}
  617.    value       : shortint;     {value of board piece}
  618.    done        : boolean;      {indicates end of directional search}
  619.    move        : movetype;     {type set if move is good}
  620.    flipcnt     : flparrytype;  {array of flips for each direction}
  621. begin
  622.    count(board,game);
  623.    if game <> continue then
  624.       done := true
  625.    else
  626.       begin
  627.          for i := 1 to 30 do   {set possible array to 0}
  628.             with possmvs[i] do
  629.                begin
  630.                   row   := 0;
  631.                   col   := 0;
  632.                   nflps := 0;
  633.                end;
  634.             for i := 1 to 10 do         {set flip array to 0}
  635.                for j := 1 to 10 do
  636.                   flipcnt[i,j]:=0;
  637.                for i  :=  2 to 9 do     {use 2 loops to cover all moves}
  638.                   begin
  639.                      for j := 2 to 9 do
  640.                         begin
  641.                            with board[i,j] do  {extract value from board}
  642.                               value := data;
  643.                            if value = player then  {check value of player}
  644.                               begin
  645.                                  for k := 1 to 8 do {search 8 poss directions}
  646.                                     begin
  647.                                        move := bad; {initialize move to bad}
  648.                                        mvi := i + xorb[k];{go first direction}
  649.                                        mvj := j + yorb[k];{go second direct}
  650.                                        with board[mvi,mvj] do
  651.      {get value from direction search}    value := data;
  652.      {make sure it is a good direct}   if value = -(player) then
  653.                                           begin
  654.      {set flip counter to one}               nflips := 1;
  655.      {repeat search until move is over }     repeat
  656.      {continue to scan}                         mvi := mvi + xorb[k];
  657.                                                 mvj := mvj + yorb[k];
  658.      {get next square value}                    with board[mvi,mvj] do
  659.      {if value is 0 then a move can be made}       value := data;
  660.                                                 if value = 0 then
  661.                                                    begin
  662.      {set move to good}                               done := true;
  663.      {indicate done with search for direction}        move := good;
  664.      {reset to original square for next search}       imov := mvi;
  665.                                                       jmov := mvj;
  666.                                                    end
  667.      {if value is still opposite of ...}        else if value = -(player) then
  668.      {...player, continue to search}               begin
  669.                                                       done := false;
  670.                                                       move  := bad;
  671.                                                       inc(nflips);
  672.                                                    end
  673.      {if value is not good then move is bad}    else if (value=player)
  674.                                                          or (value=2) then
  675.                                                    begin
  676.                                                       done := true;
  677.                                                       move := bad;
  678.                                                    end;
  679.                                              until done;
  680.                                           end;
  681.      {if move is good load into array} if move = good then
  682.                                           flipcnt[imov,jmov]:=
  683.                                           flipcnt[imov,jmov] + nflips;
  684.                                     end;
  685.                               end;
  686.                         end;
  687.                   end;
  688.                z := 0;
  689.                for x := 1 to 10 do          {load possible move array}
  690.                   for y := 1 to 10 do
  691.                      if flipcnt[x,y] <> 0 then
  692.                         begin
  693.                            z := z+1;
  694.                            with possmvs[z] do
  695.                               begin
  696.                                  row := x;
  697.                                  col := y;
  698.                                 nflps := flipcnt[x,y];
  699.                               end;
  700.                         end;
  701.       end;
  702. end;
  703.  
  704. procedure findbestmove(var value:bestmvetype;
  705.                        possmvs:posmvarrytype;
  706.                        board:boardarrytype;whosturn:integer);
  707. {using weight array, find the best possible move}
  708. var
  709.    finalval,
  710.    tempvalue,
  711.    row1,
  712.    col1,
  713.    nflps1, i   : integer;
  714. begin
  715.    if whosturn = board[2,2].data then
  716.       begin
  717.          weigharr[2,3] := 10;
  718.          weigharr[3,2] := 10;
  719.          weigharr[3,3] := 10;
  720.       end;
  721.    if whosturn = board[2,9].data then
  722.       begin
  723.          weigharr[2,8] := 10;
  724.          weigharr[3,8] := 10;
  725.          weigharr[3,9] := 10;
  726.       end;
  727.    if whosturn = board[9,2].data then
  728.       begin
  729.          weigharr[8,2] := 10;
  730.          weigharr[8,3] := 10;
  731.          weigharr[9,3] := 10;
  732.       end;
  733.    if whosturn = board[9,9].data then
  734.       begin
  735.          weigharr[8,8] := 10;
  736.          weigharr[8,9] := 10;
  737.          weigharr[9,8] := 10;
  738.       end;
  739.    value.xcoord := 0;
  740.    value.ycoord := 0;
  741.    value.val  := 0;
  742.    i := 1;
  743.    while possmvs[i].nflps <> 0 do
  744.       begin
  745.          row1 := possmvs[i].row;
  746.          col1 := possmvs[i].col;
  747.          nflps1 := possmvs[i].nflps;
  748.          tempvalue := weigharr[row1,col1] + nflps1;
  749.          if tempvalue > value.val then
  750.             begin
  751.                value.val := tempvalue;
  752.                value.xcoord := possmvs[i].row;
  753.                value.ycoord := possmvs[i].col;
  754.             end;
  755.          i := i + 1;
  756.       end;
  757. end;
  758.  
  759. PROCEDURE MAKEMOVES(MAKMOVE:MAKMOVETYPE;
  760.                     VAR BOARD:BOARDARRYTYPE;ITEM:SHORTINT);
  761. {make a given move and flip all corresponding pieces}
  762. TYPE
  763.    DIAGONALNEGTYPE=2..20;
  764.    DIAGONALPOSTYPE=-9..9;
  765. VAR
  766.    I2,I1,{USE FOR INCREMENTS}
  767.    POSHORZ,POSVERT,
  768.    TEMPORARYHORZ,
  769.    TEMPORARYVERT,
  770.    TEMPORARYITEM:SHORTINT;
  771.    DIAGONALNEG:DIAGONALNEGTYPE;
  772.    DIAGONALPOS:DIAGONALPOSTYPE;
  773.    ITEMINDICATOR:BOOLEAN;
  774. BEGIN
  775.    POSHORZ := MAKMOVE.IMM;
  776.    POSVERT := MAKMOVE.JMM;
  777.    IF (POSHORZ>1) AND (POSHORZ<10) {MAKES SURE THE POSITION IS}
  778.       AND (POSVERT>1) AND (POSVERT<10) THEN {ON THE BOARD.   }
  779.       BEGIN
  780.          IF ITEM=-1 THEN      {TEMPORARILY STORES VALUE OF}
  781.             TEMPORARYITEM := 1  {OPPOSITE COLOR FOR LATER   }
  782.          ELSE                 {REFERENCE                  }
  783.             TEMPORARYITEM := -1;
  784.          {END IF THEN}
  785.          I2 := -1;
  786.          WHILE I2<2 DO {CHECKS HORIZONTAL TO SEE IF ANY PIECES}
  787.             BEGIN   {CAN BE FLIPPED.                       }
  788.                ITEMINDICATOR := FALSE;
  789.                TEMPORARYHORZ := POSHORZ+I2;
  790.                WHILE BOARD[TEMPORARYHORZ,POSVERT].DATA
  791.                      =TEMPORARYITEM DO
  792.                   BEGIN
  793.                      TEMPORARYHORZ := TEMPORARYHORZ+I2;
  794.                      ITEMINDICATOR := TRUE;
  795.                   END;{WHILE}
  796.                   IF (ITEMINDICATOR AND
  797.                      (BOARD[TEMPORARYHORZ,POSVERT].DATA
  798.                       =ITEM)) THEN
  799.                      BEGIN  {MAKE FLIP}
  800.                         I1 := POSHORZ;
  801.                         WHILE I1<>TEMPORARYHORZ DO
  802.                            BEGIN
  803.                               BOARD[I1,POSVERT].DATA := ITEM;
  804.                               I1 := I1+I2;
  805.                            END;{WHILE}
  806.                      END;{IF THEN}
  807.                      I2 := I2+2;
  808.          END;{WHILE}
  809.          I2 := -1;
  810.          WHILE I2<2 DO {CHECKS VERTICAL TO SEE IF ANY}
  811.             BEGIN   {PIECES CAN BE FLIPPED.       }
  812.                TEMPORARYVERT := POSVERT+I2;
  813.                ITEMINDICATOR := FALSE;
  814.                WHILE BOARD[POSHORZ,TEMPORARYVERT].DATA
  815.                      =TEMPORARYITEM DO
  816.                   BEGIN
  817.                      TEMPORARYVERT := TEMPORARYVERT+I2;
  818.                      ITEMINDICATOR := TRUE;
  819.                   END;{WHILE}
  820.                IF (ITEMINDICATOR AND
  821.                   (BOARD[POSHORZ,TEMPORARYVERT].DATA=ITEM)) THEN
  822.                   BEGIN {MAKE FLIP}
  823.                      I1 := POSVERT;
  824.                      WHILE I1<>TEMPORARYVERT DO
  825.                         BEGIN
  826.                            BOARD[POSHORZ,I1].DATA := ITEM;
  827.                            I1 := I1+I2;
  828.                         END;{WHILE}
  829.                      END;{IF THEN}
  830.                      I2 := I2+2;
  831.                   END;{WHILE}
  832.                DIAGONALPOS := POSHORZ-POSVERT;
  833.                I2 := -2;
  834.                WHILE I2<3 DO {CHECKS NEGHTIVE DIAGONAL TO SEE IF ANY}
  835.                   BEGIN   {PIECES CAN BE FLIPPED.                }
  836.                      DIAGONALNEG := POSHORZ+POSVERT+I2;
  837.                      ITEMINDICATOR := FALSE;
  838.                      WHILE BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2)
  839.                            ,((DIAGONALNEG-DIAGONALPOS) DIV 2)].
  840.                            DATA=TEMPORARYITEM DO
  841.                         BEGIN
  842.                            DIAGONALNEG := DIAGONALNEG+I2;
  843.                            ITEMINDICATOR := TRUE;
  844.                         END;{WHILE}
  845.                      IF (ITEMINDICATOR AND
  846.                         (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2),
  847.                         ((DIAGONALNEG-DIAGONALPOS) DIV 2)].DATA=ITEM)) THEN
  848.                         BEGIN {MAKE FLIP}
  849.                            I1 := POSHORZ+POSVERT;
  850.                            WHILE I1<>DIAGONALNEG DO
  851.                               BEGIN
  852.                                  BOARD[((I1+DIAGONALPOS)
  853.                                       DIV 2),((I1-
  854.                                       DIAGONALPOS) DIV 2)].
  855.                                       DATA := ITEM;
  856.                                  I1 := I1+I2;
  857.                               END;{WHILE}
  858.                         END;{IF THEN}
  859.                      I2 := I2+4;
  860.                   END;{WHILE}
  861.                   DIAGONALNEG := POSHORZ+POSVERT;
  862.                   I2 := -2;
  863.                   WHILE I2<3 DO {CHECKS POSITIVE DIAGONAL TO SEE}
  864.                      BEGIN   {IF ANY PIECES CAN BE FLIPPED.  }
  865.                         DIAGONALPOS := POSHORZ-POSVERT+I2;
  866.                         ITEMINDICATOR := FALSE;
  867.                         WHILE BOARD[((DIAGONALNEG+DIAGONALPOS)
  868.                               DIV 2),((DIAGONALNEG-DIAGONALPOS)
  869.                               DIV 2)].DATA=TEMPORARYITEM DO
  870.                            BEGIN
  871.                               DIAGONALPOS := DIAGONALPOS+I2;
  872.                               ITEMINDICATOR := TRUE;
  873.                            END;{WHILE}
  874.                         IF (ITEMINDICATOR AND
  875.                            (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2),
  876.                            ((DIAGONALNEG-DIAGONALPOS) DIV 2)]
  877.                            .DATA=ITEM)) THEN
  878.                            BEGIN {MAKE FLIP}
  879.                               I1 := POSHORZ-POSVERT;
  880.                               WHILE I1<> DIAGONALPOS DO
  881.                                  BEGIN
  882.                                     BOARD[((DIAGONALNEG+I1)
  883.                                          DIV 2),((DIAGONALNEG
  884.                                          -I1) DIV 2)].DATA
  885.                                           := ITEM;
  886.                                     I1 := I1+I2;
  887.                                  END;{WHILE}
  888.                            END;{IF THEN}
  889.                         I2 := I2+4;
  890.                      END;{WHILE}
  891.    END;{IF THEN}
  892. END;{PROCEDURE}
  893.  
  894. procedure value_print(value:bestmvetype;possmvs:posmvarrytype);
  895. {special proc for debugging, will print all poss moves and best move}
  896. var
  897.    i,j:integer;           {loop variables}
  898. begin                     {blank out section of screen}
  899.    for i := 10 to 25 do
  900.       begin
  901.          gotoxy(5,i);
  902.          write(' ':33);
  903.       end;
  904.    j:=1;                  {set increment variables}
  905.    i:=10;
  906.    gotoxy(5,9);
  907.    write('mvs & flips');
  908.    while possmvs[j].nflps<>0 do
  909.       begin
  910.          gotoxy(5,i);
  911.          with possmvs[j] do
  912.             write(row,'  ',col,'  ',nflps); {write move and # of flips}
  913.          inc(i);        {increment loop variables}
  914.          inc(j);
  915.       end;
  916.    gotoxy(20,9);
  917.    write('best move & value');
  918.    gotoxy(20,10);
  919.    with value do
  920.       write(xcoord,'  ',ycoord,'       ',val); {print best move }
  921. end;
  922.  
  923. procedure locate_square(var x,y:shortint;var coordstatus:coordstatustype;
  924.                         var findempty:boolean;board:boardarrytype;
  925.                         player:shortint);
  926. {locate an open square on the board and write a char in it}
  927. var
  928.    i, j,
  929.    temparrw,
  930.    xarrw, yarrw,
  931.    tempx, tempy,
  932.    value1, tempplay : shortint; {loop and tempory values}
  933.    playchr,
  934.    tempplaychr      : string2;  {character being played}
  935.    possmvs          : posmvarrytype;  {possible move array}
  936.    value            : bestmvetype;    {value for best possibla move}
  937. begin
  938.    xarrw := 42;                     {indicate who's turn in message block}
  939.    tempplay := player;
  940.    if player = 1 then
  941.       begin
  942.          tempplaychr := '░░';
  943.          yarrw := 3;
  944.          temparrw := 5;
  945.          gotoxy(6,4);
  946.          write(tempplaychr,' ''s turn.');
  947.       end
  948.    else
  949.       begin
  950.          yarrw := 5;
  951.          tempplaychr := '██';
  952.          temparrw := 3;
  953.          gotoxy(6,4);
  954.          write(tempplaychr,' ''s turn.');
  955.       end;
  956.    gotoxy(xarrw,yarrw);     {place arrow at players score}
  957.    write('»════>');
  958.    gotoxy(xarrw,temparrw);
  959.    write('      ');
  960.    playchr := '[]';         {def pick char}
  961.    x := 42;
  962.    y := 8;
  963.    gotoxy(6,3);
  964.    write(' ':30);
  965.    i := 2;
  966.    j := 2;
  967.    coordstatus := ok;
  968.    findempty := false;
  969.    while i < 10 do       {loop until open square found or not found}
  970.       begin
  971.          repeat
  972.             with board[i,j] do
  973.                value1  :=  data;
  974.             if value1 = 0 then     {open square found}
  975.                begin
  976.                   coordstatus := ok;
  977.                   findempty := true;
  978.                   i := 10;
  979.                   tempx := x;
  980.                   tempy := y;
  981.                   gotoxy(x,y);
  982.                   write(playchr:2);
  983.                end
  984.             else
  985.                begin               {open square not found}
  986.                   coordstatus := non_avail;
  987.                   x := x+5;
  988.                   j := j+1;
  989.                end;
  990.          until (findempty) or (j=10);
  991.          x := 42;
  992.          y := y+2;
  993.          i := i+1;
  994.          j := 2;
  995.       end;
  996.    x := tempx;  {set coordinates of found square}
  997.    y := tempy;
  998. {*************** for debuggung *********************************}
  999. {findmoves(board,player,possmvs);
  1000. findbestmove(value,possmvs,board,player);
  1001. value_print(value,possmvs);}
  1002. {***************************************************************}
  1003. end;
  1004.  
  1005. procedure getcoord(player:shortint;possmvs:posmvarrytype;
  1006.                    var makmove:makmovetype);
  1007. {select a position on the board for a possible move, if move is good
  1008.  then exit procedure else write message and repeat procedure}
  1009. var
  1010.    x, y, i, j,
  1011.    num1, num2,
  1012.    yinc, xinc,
  1013.    xarrw, yarrw,
  1014.    tempx, tempy,
  1015.    value1, value2,
  1016.    ply_piece, cmp_piece : shortint;
  1017.    coordstatus          : coordstatustype;
  1018.    ch                   : char;
  1019.    findempty,
  1020.    fk                   : boolean;
  1021.    move                 : movetype;
  1022.    tempplay             : shortint;
  1023.    playchr,
  1024.    tempplaychr          : string2;
  1025. begin
  1026.    xarrw := 42;
  1027.    tempplay := player;
  1028.    if player = 1 then
  1029.       begin
  1030.          tempplaychr := '░░';
  1031.          yarrw := 3;
  1032.       end
  1033.    else
  1034.       begin
  1035.          yarrw := 5;
  1036.          tempplaychr := '██';
  1037.       end;
  1038.    playchr := '[]';
  1039.    locate_square(x,y,coordstatus,findempty,board,player);
  1040.    repeat
  1041.       if coordstatus = ok then
  1042.          begin
  1043.             repeat
  1044.                i := x;j := y;
  1045.                fk := false;
  1046.                ch := readkey;
  1047.                if ch = #0 then
  1048.                   begin
  1049.                      fk := true;
  1050.                      ch := readkey;
  1051.                   end;
  1052.                yinc := 0;xinc := 0;
  1053.                case ch of
  1054.                'H': begin                {left arrow key}
  1055.                        y := y-2;
  1056.                        yinc := -2;
  1057.                     end;
  1058.                'P': begin                {right arrow key}
  1059.                        y := y+2;
  1060.                        yinc := +2;
  1061.                     end;
  1062.                'K': begin                {up arrow key}
  1063.                        x := x-5;
  1064.                        xinc := -5;
  1065.                     end;                 {down arrow key}
  1066.                'M': begin
  1067.                        x := x+5;
  1068.                        xinc := +5;
  1069.                     end;
  1070.                end;
  1071.                if (x>77) and (y>22) then
  1072.                   begin
  1073.                      x := 42;
  1074.                      y := 8;
  1075.                   end
  1076.                else if x > 77 then
  1077.                   begin
  1078.                      x  :=  42;
  1079.                      y := y+2;
  1080.                   end
  1081.                else if x < 42 then
  1082.                   begin
  1083.                      x :=  77;
  1084.                      y :=  y - 2;
  1085.                   end;
  1086.                if y > 22 then
  1087.                   y := 8
  1088.                else if y < 8 then
  1089.                   y := 22;
  1090.                with board[(y-4) div 2,(x-32) div 5] do
  1091.                   value1 := data;
  1092.                if value1 = 0 then
  1093.                   begin
  1094.                      gotoxy(i,j);
  1095.                      write(empty:2);
  1096.                      gotoxy(x,y);
  1097.                      write(playchr:2);
  1098.                      num1 := (y-4) div 2;
  1099.                      num2 := (x-32) div 5;
  1100.                   end
  1101.                else if (value1 = 1) or (value1 = -1) then
  1102.                   begin
  1103.                      repeat
  1104.                         gotoxy(i,j);
  1105.                         write(empty:2);
  1106.                         x := x+xinc;
  1107.                         y := y+yinc;
  1108.                         if (x>77) and (y>22) then
  1109.                            begin
  1110.                               x := 42;
  1111.                               y := 8;
  1112.                            end
  1113.                         else if x > 77 then
  1114.                            begin
  1115.                               x  :=  42;
  1116.                               y := y + 2;
  1117.                            end
  1118.                         else if x < 42 then
  1119.                            begin
  1120.                               x :=  77;
  1121.                               y := y - 2;
  1122.                            end;
  1123.                         if y > 22 then
  1124.                            y := 8
  1125.                         else if y < 8 then
  1126.                            y := 22;
  1127.                         with board[(y-4) div 2,(x-32) div 5] do
  1128.                            value2 := data;
  1129.                      until value2 = 0;
  1130.                      gotoxy(x,y);
  1131.                      write(playchr:2);
  1132.                      num1 := (y-4) div 2;
  1133.                      num2 := (x-32) div 5;
  1134.                   end;
  1135.             until (not fk) and (ch = #13);
  1136.          end;
  1137.       i := 1;
  1138.       move := bad;
  1139.       repeat
  1140.          with possmvs[i] do
  1141.             if (num1=row) and (num2=col) then
  1142.                move := good
  1143.             else
  1144.                begin
  1145.                   move := bad;
  1146.                   inc(i);
  1147.                end;
  1148.       until (i=30) or (move=good);
  1149.       if move <> good then
  1150.          begin
  1151.             gotoxy(6,3);
  1152.             write('Move is bad : ',tempplaychr);
  1153.             repeat
  1154.                ch  :=  readkey;
  1155.             until (ch <> #13);
  1156.             gotoxy(6,3);
  1157.             write(' ':30);
  1158.          end;
  1159.    until move = good;
  1160.    gotoxy(xarrw,yarrw);
  1161.    write('      ');
  1162.    makmove.imm := num1;  {set final move selected by player}
  1163.    makmove.jmm := num2;
  1164. end;
  1165.  
  1166. Procedure Lookahead(var value:bestmvetype;
  1167.                       iterations:shortint;
  1168.                       possmvs:posmvarrytype;
  1169.                       board2:boardarrytype;whosturn:shortint;
  1170.                       var done:boolean);
  1171.  
  1172. var
  1173.    pass              : boolean;
  1174.    o                 : shortint;
  1175.    ov                : bestmvetype;
  1176.    tempm             : makmovetype;
  1177.    tm                : possmvsrectype;
  1178.    opponentposibles  : posmvarrytype;
  1179.    m                 : possmvsrectype;
  1180.    k                 : integer;
  1181.    size              : integer;
  1182.  
  1183. begin
  1184.    findmoves(board2,-whosturn,opponentposibles);
  1185.    findbestmove(value,possmvs,board2,whosturn);
  1186.    size := 0;
  1187.    while possmvs[size+1].nflps<>0 do
  1188.       size := size + 1;
  1189.    if size <= 0 then
  1190.       pass := true
  1191.    else if (size = 1) or (iterations = 0) then
  1192.       done := true
  1193.    else
  1194.       begin
  1195.          if whosturn = 1 then
  1196.             begin
  1197.                o := -1;
  1198.                ov.val := -3500;
  1199.             end
  1200.          else
  1201.             begin
  1202.                o := 1;
  1203.                ov.val := 3500;
  1204.             end;
  1205.          tm.row := value.xcoord;
  1206.          tm.col := value.ycoord;
  1207.          tempm.imm := tm.row;
  1208.          tempm.imm := tm.col;
  1209.          k:=1;
  1210.          if not pass then
  1211.          while (possmvs[k].nflps<>0)  do begin
  1212.  
  1213.             unmove(board2,tempboard2,save);
  1214.             makemoves(tempm,board2,whosturn);
  1215.             Lookahead(ov,iterations-1,opponentposibles,
  1216.                       board2,-whosturn,done);
  1217.             unmove(board2,tempboard2,return);
  1218.             if (whosturn = 1) and (ov.val > value.val) then
  1219.                begin
  1220.                   value := ov;
  1221.                   m := tm;
  1222.                end
  1223.             else if (whosturn = -1) and (ov.val < value.val) then
  1224.                begin
  1225.                   value :=  ov;
  1226.                   m := tm
  1227.                end;
  1228.          k:=k+1;
  1229.          tm.row := possmvs[k].row;
  1230.          tm.col := possmvs[k].col;
  1231.          tempm.imm := tm.row;
  1232.          tempm.imm := tm.col;
  1233.          end;
  1234.       end;
  1235. end;
  1236.  
  1237. procedure first_move(var board:boardarrytype);
  1238. {control the players move, if none then pass}
  1239. var
  1240.    level,                       {search level}
  1241.    xarrw, yarrw,
  1242.    num1, num2   : shortint;
  1243.    possmvs      : posmvarrytype;
  1244.    value        : bestmvetype;
  1245.    makmove      : makmovetype;
  1246. begin
  1247.    findmoves(board,firstnum,possmvs);    {make sure move is possible}
  1248.    if possmvs[1].nflps = 0 then
  1249.       begin
  1250.          gotoxy(6,3);
  1251.          write('No moves, turn passed. Wait...');
  1252.          gotoxy(6,4);
  1253.          write(' ':30);
  1254.          delay(2000);
  1255.       end
  1256.    else
  1257.       begin
  1258.          unmove(board,tempboard,save);
  1259.          getcoord(firstnum,possmvs,makmove);
  1260. {************for debuggung purposes****************************}
  1261. {        findbestmove(value,possmvs,board,firstnum);
  1262.          with makmove do
  1263.             begin
  1264.                imm:=value.xcoord;
  1265.                jmm:=value.ycoord;
  1266.             end;}
  1267. {**************************************************************}
  1268.          makemoves(makmove,board,firstnum);
  1269.       end;
  1270. end;
  1271.  
  1272. procedure second_move_1_(var board:boardarrytype);
  1273. {control computers move if none then pass}
  1274. var
  1275.    xarrw, yarrw,
  1276.    num1, num2    : shortint;
  1277.    possmvs       : posmvarrytype;
  1278.    makmove       : makmovetype;
  1279.    value         : bestmvetype;
  1280.    done          : boolean;
  1281. begin
  1282.    findmoves(board,secondnum,possmvs);
  1283.    if possmvs[1].nflps = 0 then
  1284.       begin
  1285.          gotoxy(6,3);
  1286.          write('No moves, turn passed. Wait...');
  1287.          gotoxy(6,4);
  1288.          write(' ':30);
  1289.          delay(1500);
  1290.       end
  1291.    else
  1292.       begin
  1293.          finalcount(board,num1,num2);
  1294.          gotoxy(6,3);
  1295.          write(' ':30);
  1296.          xarrw := 42;
  1297.          yarrw := 3;
  1298.          gotoxy(xarrw,yarrw);
  1299.          write('      ');
  1300.          yarrw := 5;
  1301.          gotoxy(xarrw,yarrw);
  1302.          write('»════>');
  1303.          gotoxy(6,4);
  1304.          write('Thinking...',' ':20);
  1305. {******** For debugging purposes *******************************}
  1306. {findmoves(board,secondnum,possmvs);
  1307. findbestmove(value,possmvs,board,secondnum);
  1308. value_print(value,possmvs);}
  1309. {Andy}  {unmove(board,board2,save);
  1310.          findbestmove(value,possmvs,board2,secondnum);
  1311.          gotoxy(6,3);
  1312.          write('Andy :  ',value.xcoord,'   ',value.ycoord);}
  1313. {Erich} {gotoxy(6,4);
  1314.          write('Erich : ',makmove.imm,'   ',makmove.jmm);}
  1315. {***************************************************************}
  1316.          unmove(board,board2,save);
  1317.          lookahead(value,level,possmvs,board2,secondnum,done);
  1318.          makmove.imm := value.xcoord;
  1319.          makmove.jmm := value.ycoord;
  1320.          delay(500);
  1321.          gotoxy(6,4);
  1322.          write(' ':30);
  1323.          gotoxy(6,3);
  1324.          write(' ':30);
  1325.          gotoxy(xarrw,yarrw);
  1326.          write('      ');
  1327.          makemoves(makmove,board,secondnum);
  1328.       end;
  1329. end;
  1330.  
  1331. procedure second_move_2_(var board:boardarrytype);
  1332. {if computer is not playing then this controls second players move}
  1333. var
  1334.    level,
  1335.    xarrw, yarrw,
  1336.    num1, num2   : shortint;
  1337.    possmvs      : posmvarrytype;
  1338.    value        : bestmvetype;
  1339.    makmove      : makmovetype;
  1340. begin
  1341.    findmoves(board,secondnum,possmvs);
  1342.    if possmvs[1].nflps = 0 then
  1343.       begin
  1344.          gotoxy(6,3);
  1345.          write('No moves, turn passed. Wait...');
  1346.          gotoxy(6,4);
  1347.          write(' ':30);
  1348.          delay(1500);
  1349.       end
  1350.    else
  1351.       begin
  1352.          unmove(board,tempboard2,save);
  1353.          getcoord(secondnum,possmvs,makmove);
  1354.          makemoves(makmove,board,secondnum);
  1355.       end;
  1356. end;
  1357.  
  1358. procedure deter_winner(game:gamestatus);
  1359. {this procedure will determine a winner at the end of the game}
  1360. var
  1361.    i, j : shortint;
  1362. begin
  1363.    finalcount(board,i,j);
  1364.    gotoxy(6,3);
  1365.    write(' ':30);
  1366.    gotoxy(6,3);
  1367.    if (i+j<>64) then
  1368.       begin
  1369.          if quit = true then
  1370.             write('Game Stopped.              ')
  1371.          else
  1372.             write('No moves for either player.');
  1373.          if i>j then
  1374.             begin
  1375.                gotoxy(6,4);
  1376.                write('Player #1 Wins!!!');
  1377.             end
  1378.          else if i<j then
  1379.             begin
  1380.                gotoxy(6,4);
  1381.                write('Player #2 Wins!!!');
  1382.             end
  1383.          else
  1384.             begin
  1385.                gotoxy(6,4);
  1386.                write('Tie!!!           ')
  1387.             end
  1388.       end
  1389.    else if (i+j)=64 then
  1390.       begin
  1391.          gotoxy(6,4);
  1392.          write(' ':30);
  1393.          gotoxy(6,3);
  1394.          if game=first_win then
  1395.             write('Player #1 Wins!!!')
  1396.          else if game=second_win then
  1397.             begin
  1398.                write('Player #2 Wins!!!');
  1399.                gotoxy(6,4);
  1400.                write('HA! HA!');
  1401.             end
  1402.          else if game=tie then
  1403.             write('Tie!!!           ');
  1404.       end;
  1405. end;
  1406.  
  1407. procedure check_game_done(var done:boolean);
  1408. {check to see if the game is at a standstill and game is over}
  1409. var
  1410.    i, j     : shortint;
  1411.    possmvs : posmvarrytype;
  1412. begin
  1413.    findmoves(board,firstnum,possmvs);
  1414.    i := possmvs[1].nflps;
  1415.    findmoves(board,secondnum,possmvs);
  1416.    j := possmvs[1].nflps;
  1417.    if (i=0) and (j=0) then
  1418.       done := true;
  1419.    if not done then
  1420.       pass := false;
  1421. end;
  1422.  
  1423. procedure pick_option(play:playtype);
  1424. {pick an option during the playing of the game}
  1425. var
  1426.    i,
  1427.    d1,
  1428.    d2      : shortint;       {necessary dummy variables for locate_square}
  1429.    d3      : coordstatustype;
  1430.    d4      : boolean;
  1431.    possmvs : posmvarrytype;
  1432.    value   : bestmvetype;
  1433. begin
  1434.    if play = first then
  1435.       i := firstnum
  1436.    else
  1437.       i := secondnum;
  1438.    locate_square(d1,d2,d3,d4,board,i);
  1439.    ch := readkey;
  1440.    ch := upcase(ch);
  1441.    if ch in ['Q','P','U','S','H'] then
  1442.       begin
  1443.          case ch of
  1444.             'Q': begin
  1445.                     quit := true;
  1446.                     done := true;
  1447.                     game := tie;
  1448.                  end;
  1449.             'P': begin
  1450.                     gotoxy(6,3);
  1451.                     write('Too bad!!!');
  1452.                     unmove(board,tempboard,save);
  1453.                     pass := true;
  1454.                     delay(1500);
  1455.                  end;
  1456.             'U': begin
  1457.                     gotoxy(6,3);
  1458.                     write('You don''t think clear!!!');
  1459.                     if not play_1 then
  1460.                        begin
  1461.                           if play = first then
  1462.                              unmove(board,tempboard,return)
  1463.                           else
  1464.                              unmove(board,tempboard2,return)
  1465.                        end
  1466.                     else
  1467.                        unmove(board,tempboard,return);
  1468.                     print_board(board,game);
  1469.                     delay(1500);
  1470.                  end;
  1471.             'S': begin
  1472.                     gotoxy(6,3);
  1473.                     write('Cant handle it???');
  1474.                     reverse_board(board);
  1475.                     unmove(board,tempboard,save);
  1476.                     pass := true;
  1477.                     delay(1500);
  1478.                  end;
  1479.             'H': begin
  1480.                     gotoxy(6,3);
  1481.                     write('Hope It Helps???');
  1482.                     if play = first then
  1483.                        begin
  1484.                           findmoves(board,firstnum,possmvs);
  1485.                           findbestmove(value,possmvs,board,firstnum);
  1486.                        end
  1487.                     else
  1488.                        begin
  1489.                           findmoves(board,secondnum,possmvs);
  1490.                           findbestmove(value,possmvs,board,secondnum);
  1491.                        end;
  1492.                     d1:=42;
  1493.                     d2:=8;
  1494.                     for i:=2 to value.ycoord-1 do
  1495.                        d1:=d1+5;
  1496.                     for i:=2 to value.xcoord-1 do
  1497.                        d2:=d2+2;
  1498.                     gotoxy(d1,d2);
  1499.                     highvideo;
  1500.                     textattr := textattr+128;
  1501.                     write('═>');
  1502.                     normvideo;
  1503.                     lowvideo;
  1504.                     delay(1500);
  1505.                  end;
  1506.             end;
  1507.       end;
  1508. end;
  1509.  
  1510. procedure execute_first_move;
  1511. {execute first players move}
  1512. begin
  1513.    if (game = continue) and (not pass) then
  1514.       begin
  1515.          first_move(board);
  1516.          print_board(board,game);
  1517.       end;
  1518.    pass := false;
  1519. end;
  1520.  
  1521. procedure execute_second_move;
  1522. {execute second players move-computer or person is determined}
  1523. var
  1524.    i, j : shortint;
  1525. begin
  1526.    if not play_1 then
  1527.       begin
  1528.          play := second;
  1529.          finalcount(board,i,j);
  1530.          if i+j<>64 then
  1531.             pick_option(play)
  1532.          else
  1533.             game:=tie;
  1534.       end;
  1535.    if (game = continue) and (not pass) then
  1536.       begin
  1537.          if play_1 then
  1538.             begin
  1539.               finalcount(board,i,j);
  1540.                if i+j<>64 then
  1541.                    second_move_1_(board);
  1542.                print_board(board,game);
  1543.                pass := false;
  1544.             end
  1545.          else
  1546.             begin
  1547.                second_move_2_(board);
  1548.                print_board(board,game);
  1549.             end
  1550.       end;
  1551. end;
  1552.  
  1553. procedure terminate_game;
  1554. {termination procedures of game}
  1555. var
  1556.    ch : char;
  1557. begin
  1558.    ch := readkey;
  1559.    cursor('M',on);
  1560.    cursor('M',on);
  1561. end;
  1562.  
  1563. { MAIN-ROUTINE }
  1564. { Controls Initializing, Processing, and Termination }
  1565. Begin
  1566.    init_game(board);
  1567.    repeat
  1568.       pick_option(first);
  1569.       execute_first_move;
  1570.       execute_second_move;
  1571.       check_game_done(done);
  1572.    until (game <> continue) or (done);
  1573.    deter_winner(game);
  1574.    terminate_game;
  1575. End.
  1576.  
  1577.  
  1578.  
  1579.  
  1580.  
  1581.  
  1582.  
  1583.  
  1584.  
  1585.  
  1586.  
  1587.  
  1588.  
  1589.  
  1590.  
  1591.